title RMAIL hack for SAIL
	subttl MRC 11/16/76

.insrt macros

headbf:	block 50.			; mail header buffer

RMAIL:	jfcl				; CCL entry
	reset				; reset all I/O
	movei msgbfr			; load addr of message buffer
	addx 0,4001.			; allow plenty of space
	movem .jbff			; and make sure buffers go after
	hrlm .jbsa			; in the other place too
	core				; get some core
	 jrst 4,.			; damn it!
	getppn				; get my PPN
	 jfcl				; silly skip
	hrrzm maibox			; save mailbox name
	open [0 ? 'DSK,, ? inpbf]	; get DSK input channel
	 jrst 4,.-1			; no DSK channels?
	open 1,[0 ? 'DSK,, ? outbf,,]	; get DSK output channel
	 jrst 4,.-1			; no DSK channels?
	open 2,[200 ? 'TTY,, ? 0]	; turn off TTY echoing
	 jrst 4,.-1			; TTY open failure?
	lookup maibox			; new mail in my mailbox?
	 jrst peruse			; no, just peruse old mail
	enter 1,[sixbit/RMAIL TMP/ ? 0 ? 0]; create a temp file
	 jrst 4,.-1			; can't create TMP file?
etvfls:	jsr inpchr			; get a character
	 jrst 4,.-1			; not an ETV file?
	caxe 0,↑L			; end of ETV directory?
	 jrst etvfls			; not yet
cpynew:	jsr inpchr			; get a character
	 jrst cpyold			; all done
	jsr putchr			; shove it in file
	jrst cpynew			; loop for more
cpyold:	rename delblk			; delete mail file
	 jrst 4,.-1			; delete failed?
	release				; free up channel
	open [0 ? 'DSK,, ? inpbf]	; open up channel
	 jrst 4,.-1			; open failure?
	lookup oldblk			; find old RMAIL file
	 jrst rname			; none, just rename
	movx 0,↑L			; terminating form feed
	jsr putchr			; shove character out
cpyol1:	jsr inpchr			; get character
	 jrst delold			; done, delete old file
	jsr putchr			; store character
	jrst cpyol1			; and loop for more
delold:	rename delblk			; pfft goes this file!
	 jrst 4,.-1			; delete error?
rname:	rename 1,newblk			; and show updated file
	 jrst 4,.-1			; rename failure?
peruse:	release				; free up read
	release 1,			; free up write
	open [0 ? 'DSK,, ? inpbf]	; open input file
	 jrst 4,.-1			; open failed???
	open 1,[0 ? 'DSK,, ? outbf,,]	; open output file
	 jrst 4,.-1			; open failed?
	lookup redblk			; open input side
	 exit				; FNF, exit
	enter 1,wrtblk			; open output side
	 jrst 4,.-1			; can't overwrite file?
gethed:	move 1,[point. 7,headbf]	; load buffer pointer
	store %zeros,headbf,headbf+49.	; clear header buffer
gethd1:	jsr inpchr			; get a character
	 jrst quit			; none to get, quit
	idpb 1				; save char in buffer
	caxe 0,↑J			; hit LF yet?
	 jrst gethd1			; not yet
	outstr headbf			; output header buffer
	store %zeros,msgbfr,msgbfr+3999.; clear message buffer
	move 1,[point. 7,msgbfr]	; load pointer to message buffer
getmsg:	jsr inpchr			; get a character
	 jrst gotmsg			; none to get, got it
	caxn 0,↑L			; form feed?
	 jrst gotmsg			; yes, start display
	idpb 1				; save in buffer
	jrst getmsg			; and loop for more
gotmsg:	skipe msgbfr			; any message?
	 outstr [asciz/--More--/]	; prompt for more
cmnd:	inchrw				; get a command
	caxle 0,<"←>			; lower case?
	 txz 0,<" >			; yes, make upper case
	caxn 0,<" >			; print more?
	 jrst [	outstr [asciz/
/]
		outstr msgbfr		; yes, print more
		jrst cmnd]		; and get a command
	caxn 0,"D			; delete?
	 jrst [	outstr [asciz/
/]
		jrst gethed]		; go to next message
	caxn 0,"N			; next message
	 jrst [	outstr [asciz/
/]
		jsr wrtmsg		; write message
		jrst gethed]		; and get next one
	caxn 0,"?			; give help?
	 jrst [	outstr [asciz/Options:
<space>	type body of message
D	Delete this message from RMAIL.TXT file
N	go to Next message, preserving this one
X	eXit, implied by D or N on last message
?	type this cruft
/]
		jrst cmnd]		; end of cruft
	caxe 0,"X			; exit?
	 jrst [	clrbfi			; no, flush input
		outstr [asciz/Bad -- "?" for help
/]					; error message
		jrst cmnd]		; and get a command again
	jsr wrtmsg			; write out message
	jsr inpchr			; get a character
	 jrst quit			; none to get, quit
	jsr putchr			; output it
	jrst .-3			; and loop for more
quit:	close 1,			; close off file
	exit				; and exit

wrtmsg:	0				; return pc
irps bfr,,[headbf msgbfr]
	 move 1,[point. 7,bfr]		; load buffer pointer
	 ildb 1				; get a character
	 jumpn [jsr putchr		; save it if non-null
		jrst .-1]		; and loop for more
termin
	movx 0,↑L			; get a form feed
	jsr putchr			; and output it
	jrst 2,@wrtmsg			; and return

inpchr:	0				; return pc
	sosg inpbf+2			; buffer ready?
	 in				; no, get something
	  txna				; won
	   jrst 2,@inpchr		; lost, return non-skip
	ildb inpbf+1			; get a character
	jumpe inpchr+1			; flush nulls
	aos inpchr			; bump return pc
	jrst 2,@inpchr			; and return

putchr:	0				; return pc
	sosg outbf+2			; buffer full?
	 out 1,				; yes, slam it out
	  txna				; won
	   jrst 4,.-1			; lost
	idpb outbf+1			; save character
	jrst 2,@putchr			; and save character

maibox:	0				; fn1
	'MSG,,				; fn2
	0				; date cruft
	sixbit/  2  2/			; PPN

irps typ,,[old new red wrt]
 typ!blk: sixbit/RMAIL TXT/ ? 0 ? 0	; RMAIL file lookup block
termin

delblk:	repeat 4,[0 ?]			; file delete block

inpbf:	block 3				; input buffer header
outbf:	block 3				; output buffer header

	constants			; literals
	variables			; variables
msgbfr:	block 1				; message buffer

	end RMAIL